﻿Imports System.Reflection, System.Threading, System.ComponentModel, System.Runtime.InteropServices
Imports System.Windows.Forms
Public Class HookSel
    ''' <summary>本类可以在.NET环境下使用系统键盘与鼠标钩子</summary>
#Region "定义结构"

    Public Structure POINTAPI
        Dim X As Integer
        Dim Y As Integer
    End Structure

    Private Structure MouseHookStruct
        Dim PT As Point
        Dim Hwnd As Integer
        Dim WHitTestCode As Integer
        Dim DwExtraInfo As Integer
    End Structure

    Private Structure MouseLLHookStruct
        Dim PT As Point
        Dim MouseData As Integer
        Dim Flags As Integer
        Dim Time As Integer
        Dim DwExtraInfo As Integer
    End Structure

    <StructLayout(LayoutKind.Explicit)>
    Private Structure INPUT
        <FieldOffset(0)>
        Public type As Integer
        <FieldOffset(4)>
        Public mi As MOUSEINPUT
        <FieldOffset(4)>
        Public ki As KEYBDINPUT
        <FieldOffset(4)>
        Public hi As HARDWAREINPUT
    End Structure

    Private Structure MOUSEINPUT
        Public dx As Integer
        Public dy As Integer
        Public mouseData As Integer
        Public dwFlags As Integer
        Public time As Integer
        Public dwExtraInfo As IntPtr
    End Structure

    Private Structure KEYBDINPUT
        Public wVk As Short
        Public wScan As Short
        Public dwFlags As Integer
        Public time As Integer
        Public dwExtraInfo As IntPtr
    End Structure

    Private Structure HARDWAREINPUT
        Public uMsg As Integer
        Public wParamL As Short
        Public wParamH As Short
    End Structure
#End Region

#Region "API声明导入"
    Private Declare Function GetCursorPos Lib "user32" Alias "GetCursorPos" (ByRef lpPoint As POINTAPI) As Integer
    '返回包含了指定点的窗口的句柄。忽略屏蔽、隐藏以及透明窗口
    Private Declare Function WindowFromPoint Lib "user32" Alias "WindowFromPoint" (ByVal xPoint As Integer, ByVal yPoint As Integer) As Integer
    Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Integer, ByVal lpfn As HookProc, ByVal hMod As IntPtr, ByVal dwThreadId As Integer) As Integer
    Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal idHook As Integer) As Integer
    Private Declare Function CallNextHookEx Lib "user32" (ByVal idHook As Integer, ByVal nCode As Integer, ByVal wParam As Integer, ByVal lParam As IntPtr) As Integer
    Private Declare Function ToAscii Lib "user32" (ByVal uVirtKey As Integer, ByVal uScancode As Integer, ByVal lpdKeyState As Byte(), ByVal lpwTransKey As Byte(), ByVal fuState As Integer) As Integer
    Private Declare Function GetKeyboardState Lib "user32" (ByVal pbKeyState As Byte()) As Integer
    Private Declare Function GetKeyState Lib "user32" (ByVal vKey As Integer) As Short
    Private Delegate Function HookProc(ByVal nCode As Integer, ByVal wParam As Integer, ByVal lParam As IntPtr) As Integer

    Private Declare Function SetForegroundWindow Lib "user32" Alias "SetForegroundWindow" (ByVal hwnd As Integer) As Integer
    Private Declare Sub keybd_event Lib "user32" Alias "keybd_event" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Integer, ByVal dwExtraInfo As Integer)
    Private Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Integer, ByVal wMapType As Integer) As Integer
    Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Integer, ByVal lpString As System.Text.StringBuilder, ByVal cch As Integer) As Integer
    Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Integer) As Integer
    Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
    Private Declare Function GetParent Lib "user32" Alias "GetParent" (ByVal hwnd As Integer) As Integer
    Private Declare Function SendInput Lib "user32" (ByVal nInputs As Integer, ByVal pInputs() As INPUT, ByVal cbSize As Integer) As Integer
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Byte(), ByRef Source As KEYBDINPUT, ByVal Length As Integer)
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Integer)
    Private Declare Auto Function GetClassName Lib "user32.dll" (ByVal hwnd As IntPtr, ByVal className As System.Text.StringBuilder, ByVal buffersize As Integer) As Integer
#End Region

#Region "常量声明"
    Private Const INPUT_KEYBOARD = 1
    Private Const WH_MOUSE_LL = 14
    Private Const WH_MOUSE = 7
    Private Const WM_MOUSEMOVE = &H200
    Private Const WM_LBUTTONDOWN = &H201
    Private Const WM_RBUTTONDOWN = &H204
    Private Const WM_MBUTTONDOWN = &H207
    Private Const WM_LBUTTONUP = &H202
    Private Const WM_RBUTTONUP = &H205
    Private Const WM_MBUTTONUP = &H208
    Private Const WM_LBUTTONDBLCLK = &H203
    Private Const WM_RBUTTONDBLCLK = &H206
    Private Const WM_MBUTTONDBLCLK = &H209
    Private Const WM_MOUSEWHEEL = &H20A
    Private Const WM_KEYDOWN = &H100
    Private Const WM_KEYUP = &H101
    Private Const WM_SYSKEYDOWN = &H104
    Private Const WM_SYSKEYUP = &H105
    Private Const VK_SHIFT As Byte = &H10
    Private Const VK_CONTROL = &H11
    Private Const VK_INSERT = &H2D
    Private Const WM_CHAR = &H102
    Private Const VK_C = &H43
    Private Const VK_NUMLOCK As Byte = &H90
    Private Const KEYEVENTF_KEYUP = &H2

    Private Const WM_CUT = &H300
    Private Const WM_PASTE = &H302
    Private Const WM_GETTEXT = &HD
    Private Const EM_GETSEL = &HB0
    Private Const WM_SETFOCUS = &H7
#End Region

#Region "事件委托处理"
    ''' <summary>鼠标激活事件</summary>
    Event selComplete(ByVal hwnd As Integer, ByVal wps As Boolean)

#End Region
    Private oldPoint, nowPoint As POINTAPI
    Private appHwnd As Integer
    Private hMouseHook As Integer
    Private doFirst As Boolean = False
    Private Shared MouseHookProcedure As HookProc


#Region "创建与析构类型"

    ''' <summary>创建一个全局鼠标键盘钩子 (请使用Start方法开始监视)</summary>
    Sub New()
        '留空即可
    End Sub

    ''' <summary>析构函数</summary>
    Protected Overrides Sub Finalize()
        UnHook() '卸载对象时反注册系统钩子
        MyBase.Finalize()
    End Sub

#End Region

    ''' <summary>开始安装系统钩子</summary>
    Public Sub StartHook()
        '注册鼠标钩子
        If hMouseHook = 0 Then
            MouseHookProcedure = New HookProc(AddressOf MouseHookProc)
            hMouseHook = SetWindowsHookEx(WH_MOUSE_LL, MouseHookProcedure, Marshal.GetHINSTANCE(Assembly.GetExecutingAssembly.GetModules()(0)), 0)
            If hMouseHook = 0 Then
                UnHook(True)
                Throw New Win32Exception(Marshal.GetLastWin32Error)
            End If
        End If
    End Sub
    ''' <summary>立刻卸载系统钩子</summary>
    ''' <param name="ThrowExceptions">是否报告错误</param>
    Public Sub UnHook(Optional ByVal ThrowExceptions As Boolean = False)
        '卸载鼠标钩子
        If hMouseHook <> 0 Then
            Dim retMouse As Integer = UnhookWindowsHookEx(hMouseHook)
            hMouseHook = 0
            If ThrowExceptions AndAlso retMouse = 0 Then
                Throw New Win32Exception(Marshal.GetLastWin32Error)
            End If
        End If
    End Sub

    '鼠标消息的委托处理代码
    Private Function MouseHookProc(ByVal nCode As Integer, ByVal wParam As Integer, ByVal lParam As IntPtr) As Integer
        If nCode >= 0 Then
            Static mouseHookStruct As MouseLLHookStruct
            mouseHookStruct = DirectCast(Marshal.PtrToStructure(lParam, GetType(MouseLLHookStruct)), MouseLLHookStruct)
            Static moubut As MouseButtons : moubut = MouseButtons.None '鼠标按键
            Static mouseDelta As Integer : mouseDelta = 0 '滚轮值
            Dim getSelT As String = ""
            Select Case wParam
                Case WM_LBUTTONDOWN
                    If doFirst = False Then
                        GetCursorPos(oldPoint)
                        appHwnd = WindowFromPoint(oldPoint.X, oldPoint.Y)
                        doFirst = True
                    End If
                Case WM_LBUTTONUP
                    If doFirst = True Then
                        GetCursorPos(nowPoint)
                        Dim nowHwnd As Integer = WindowFromPoint(nowPoint.X, nowPoint.Y)
                        Dim s As New System.Text.StringBuilder(256)
                        Dim t As New System.Text.StringBuilder(256)
                        GetClassName(nowHwnd, s, s.Capacity)
                        Dim className = s.ToString()
                        GetWindowText(nowHwnd, t, t.Capacity)
                        Dim title = t.ToString()
                        Dim wps As Boolean = False
                        If (oldPoint.X - nowPoint.X >= 5 Or nowPoint.X - oldPoint.X > 5) And doFirst = True And className <> "DirectUIHWND" And nowHwnd <> selfHwnd Then
                            If (title = "DocView") Then
                                wps = True
                            End If
                            RaiseEvent selComplete(nowHwnd, wps)
                        End If
                        doFirst = False
                    End If
            End Select
        End If
        Return CallNextHookEx(hMouseHook, nCode, wParam, lParam) '激活下一个钩子
    End Function

    Public Function VarPtr(ByVal e As Object) As Integer
        Dim GC As GCHandle
        Dim GC2 As Integer
        GC = GCHandle.Alloc(e, GCHandleType.Pinned)
        GC2 = GC.AddrOfPinnedObject.ToInt32
        GC.Free()
        Return GC2
    End Function

    ''' <summary>鼠标钩子是否有效</summary>
    Public Property MouseHookEnabled() As Boolean
        Get
            Return hMouseHook <> 0
        End Get
        Set(ByVal value As Boolean)
            If value = True Then StartHook() Else UnHook()
        End Set
    End Property

    Public Sub NetSendKeyCTRLplus(bkey As Integer)
        Dim GInput(3) As INPUT
        'press the key ctrl
        GInput(0).type = INPUT_KEYBOARD
        GInput(0).ki.wVk = 17
        GInput(0).ki.dwFlags = 0
        ' press the key
        GInput(1).type = INPUT_KEYBOARD
        GInput(1).ki.wVk = bkey
        GInput(1).ki.dwFlags = 0
        ' release the key
        GInput(2).type = INPUT_KEYBOARD
        GInput(2).ki.wVk = bkey
        GInput(2).ki.dwFlags = KEYEVENTF_KEYUP
        ' release the ctrl
        GInput(3).type = INPUT_KEYBOARD
        GInput(3).ki.wVk = 17
        GInput(3).ki.dwFlags = KEYEVENTF_KEYUP
        SendInput(4, GInput, Marshal.SizeOf(GetType(INPUT)))
    End Sub

    Public Function findTopParent(ByVal hwnd As Integer) As Integer
        Dim paret = GetParent(hwnd)
        If paret = 0 Then
            Return hwnd
        Else
            Return findTopParent(paret)
        End If
    End Function


End Class
